perm filename UHASH[S1,ALS] blob
sn#455984 filedate 1979-07-10 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (************************************************************************)
C00023 ENDMK
C⊗;
(************************************************************************)
(* H a s h i n g *)
(************************************************************************)
HASHMOD = 127; (* hash table size. *)
MAXHASH = 126; (* MAXHASH - 1 *)
HASHCH = 7; (* hashword size *)
MAXLONGCH = 1000; (* longhash table size limit *)
(************************************************************************)
(* H a s h i n g *)
(************************************************************************)
HASHRANGE = 0..MAXHASH;
HASHCHRANGE = 0..HASHCH;
LBCDRANGE = 0..MAXLONGCH;
HASHWORD = PACKED ARRAY[HASHCHRANGE] OF CHAR;
PTRHASH = ↑HASH;
PTRLHASH = ↑LHASH;
HASH = RECORD
LINK : PTRHASH;
NAME : HASHWORD;
CASE
(*%IFT CRAY-1 *)
(* QZQ1:*)
(*%ENDC CRAY-1 *)
INTEGER OF
0: (OPDATA : INTEGER);
1: (IDATA : INTEGER);
2: (LHPDATA : PTRLHASH)
END;
LHASH = RECORD
LLINK : PTRLHASH;
LOFF : LBCDRANGE;
LLEN : LBCDRANGE;
LDATA : INTEGER
END;
INTEGER OF
0: (CASELAB : PTRHASH);
1: (QSTRING : PTRLHASH)
END;
PTRUNODE = ↑UNODE;
UNODE = PACKED RECORD
OPCODE : OPCODERANGE;
LAB : PTRHASH;
ATYPE : DTYPE;
BTYPE : DTYPE;
COMMENT : PTRLHASH;
LOBJECT : LABELFIELD;
DOBJECT : DATAOBJECT
END;
(* H a s h i n g *)
(************************************************************************)
CURBCDPTR : LBCDRANGE;
LONGCHRS : PACKED ARRAY[LBCDRANGE] OF CHAR;
HASHANCHORS : ARRAY[HASHRANGE] OF PTRHASH;
(************************************************************************)
CURPROCNAME : HASHWORD;
(************************************************************************)
(* H a s h M o d u l e *)
(************************************************************************)
FUNCTION GETHASH(VAR INKEY:HASHWORD; VAR TF:BOOLEAN):PTRHASH;
FORWARD;
FUNCTION GETLHASH(VAR BUF:INPUTLINE; OFF,LEN:LINERANGE;
VAR NEWONE:BOOLEAN):PTRLHASH;
FORWARD;
(************************************************************************)
PROCEDURE INITHASHMODULE;
VAR
OP : OPCODERANGE;
TF : BOOLEAN;
KEY : HASHWORD;
WHERE : PTRHASH;
SCAN : INTEGER;
BEGIN
CURBCDPTR:=0;
FOR SCAN:=0 TO MAXHASH DO HASHANCHORS[SCAN]:=NIL;
KEY:=' <OP>';
FOR OP:=PABS TO PEOF DO
WITH UINFO[OP] DO
BEGIN
FOR SCAN:=0 TO 3 DO KEY[SCAN]:=CHRS[SCAN];
WHERE:=GETHASH(KEY,TF);
WHERE↑.OPDATA:=ORD(OP);
END;
END;
INITHASHMODULE;
PROCINFO = ARRAY[PROCRANGE] OF
RECORD
NAME : PTRHASH;
PRES : ACTIVATIONRECORD
END;
PROCEDURE ADJUSTLABEL(VAR U:UNODE; N:INTEGER);
VAR NEWLAB:HASHWORD;
TF:BOOLEAN;
I:INTEGER;
BEGIN
IF OPSET5[U.OPCODE] THEN
BEGIN
FOR I:=7 DOWNTO 0 DO
IF N > 0 THEN
BEGIN
NEWLAB[I]:=CHR((N MOD 10)+ORD('0'));
N:=N DIV 10;
END
ELSE
NEWLAB[I]:='0';
WITH U.LAB↑ DO
FOR I:=0 TO 7 DO
IF (NAME[I] <> ' ') THEN
IF (NEWLAB[I] = '0') THEN
NEWLAB[I]:=NAME[I]
ELSE
NONFATALERROR('Copy label error');
U.LAB:=GETHASH(NEWLAB,TF);
END;
END;
FUNCTION HASHVAL(VAR INKEY:HASHWORD) : HASHRANGE;
(************************************************************************)
(* HASHES A CHARACTER STRING BY PLUS, SHIFT, MOD *)
(* RLS 28 DEC 77 *)
(************************************************************************)
VAR
I : HASHCHRANGE;
FUDGEA : INTEGER;
FUDGEB : INTEGER;
BEGIN (* hashval *)
FUDGEA:=0;
FOR I:=0 TO HASHCH DO
FUDGEA:=FUDGEA+FUDGEA+ORD(INKEY[I]); (* left shift,and add *)
FUDGEA:=FUDGEA DIV HASHMOD; (* hi-order part *)
FUDGEB:=FUDGEA MOD HASHMOD; (* lo-order part *)
HASHVAL:=(FUDGEA+FUDGEB) MOD HASHMOD;
END; (* hashval *)
FUNCTION GETHASH (* (VAR INKEY:HASHWORD; VAR TF:BOOLEAN) : PTRHASH *);
(************************************************************************)
(* RETURNS A POINTER TO A HASH ITEM CORRESPONDING TO INKEY *)
(* TF IS SET TRUE IF A NEW ENTRY IS MADE *)
(* RLS 18 JAN 78 *)
(************************************************************************)
VAR
K : HASHRANGE;
P : PTRHASH;
MORE : BOOLEAN;
BEGIN
K:=HASHVAL(INKEY);
P:=HASHANCHORS[K];
MORE:=(P<>NIL);
WHILE MORE DO
IF P↑.NAME=INKEY THEN
MORE:=FALSE
ELSE
BEGIN
P:=P↑.LINK;
MORE:=P<>NIL;
END;
TF:=(P=NIL);
IF TF THEN
BEGIN
NEW(P);
WITH P↑ DO
BEGIN
LINK:=HASHANCHORS[K];
HASHANCHORS[K]:=P;
NAME:=INKEY;
IDATA:=UNDEFDATA;
END;
END;
GETHASH:=P;
IF 'H' IN DEBUGSET THEN
WITH P↑ DO
BEGIN
WRITE(LOGFILE,' Hashword = "',NAME,'"');
WRITE(LOGFILE,' Hashval = ',K:3);
WRITE(LOGFILE,' Gethash = ',ORD(P):6);
WRITE(LOGFILE,' New = ',ORD(TF):2);
WRITELN(LOGFILE);
END;
END; (* GETHASH *)
FUNCTION GETLHASH (* (VAR BUF:INPUTLINE; OFF,LEN:LINERANGE;
VAR NEWONE:BOOLEAN):PTRLHASH *) ;
(************************************************************************)
(* JJF 15 FEB 78 *)
(* Returns a pointer to a long hash item corresponding to LINEBUF *)
(* NEWONE is set to TRUE if a new entry is made *)
(* Does short hash on CONCAT(' ',CHR(LEN),first 6 char of BUF) to *)
(* find linked list of long strings. *)
(* It then resolves any collisions on the long string list. *)
(************************************************************************)
VAR
SHORTHASH :HASHWORD;
SHORTSPOT :PTRHASH;
MORE :BOOLEAN;
LONGITEM :PTRLHASH;
ISNEW :BOOLEAN;
I :INTEGER;
FUNCTION SAMESTRING(VAR BUFFER:INPUTLINE;LITEM:PTRLHASH):BOOLEAN;
VAR
COUNT :INTEGER;
BEGIN
WITH LITEM↑ DO
IF LEN = LLEN THEN
BEGIN
COUNT:=0;
WHILE (COUNT<LEN) AND (BUFFER[OFF+COUNT]=LONGCHRS[LOFF+COUNT]) DO
COUNT:=COUNT+1;
SAMESTRING:=COUNT=LEN;
END
ELSE
SAMESTRING:=FALSE
END;
PROCEDURE GLH1;
BEGIN
SHORTHASH[0]:=' ';
SHORTHASH[1]:=CHR(32 + LEN MOD 64);
FOR I:=2 TO HASHCH DO
IF I < LEN THEN
SHORTHASH[I]:=BUF[OFF+I-2]
ELSE
SHORTHASH[I]:=' ';
SHORTSPOT:=GETHASH(SHORTHASH,ISNEW);
IF ISNEW THEN SHORTSPOT↑.LHPDATA:=NIL;
LONGITEM:=SHORTSPOT↑.LHPDATA;
MORE:=(LONGITEM<>NIL);
WHILE MORE DO
IF SAMESTRING(BUF,LONGITEM) THEN
MORE:=FALSE
ELSE
BEGIN
LONGITEM:=LONGITEM↑.LLINK;
MORE:=LONGITEM<>NIL;
END;
END; (* glh1 *)
PROCEDURE GLH2;
BEGIN
NEWONE:=(LONGITEM=NIL);
IF NEWONE THEN
IF (LEN+CURBCDPTR) > MAXLONGCH THEN
NONFATALERROR('longhashtab full')
ELSE
BEGIN
NEW(LONGITEM);
WITH LONGITEM↑ DO
BEGIN
LLINK:=SHORTSPOT↑.LHPDATA;
SHORTSPOT↑.LHPDATA:=LONGITEM;
LOFF:=CURBCDPTR;
LLEN:=LEN;
FOR I:=OFF TO OFF+LEN-1 DO
BEGIN
LONGCHRS[CURBCDPTR]:=BUF[I];
CURBCDPTR:=CURBCDPTR+1;
END;
LDATA:=UNDEFDATA;
END;
END;
END; (* glh2 *)
BEGIN (* getlhash *)
GLH1;
GLH2;
GETLHASH:=LONGITEM;
IF 'L' IN DEBUGSET THEN
WITH LONGITEM↑ DO
BEGIN
WRITE(LOGFILE,' String = ');
FOR I:=LOFF TO LOFF+LLEN-1 DO WRITE(LOGFILE,LONGCHRS[I]);
WRITELN(LOGFILE);
WRITE(LOGFILE,' Getlhash = ',ORD(LONGITEM):6);
WRITE(LOGFILE,' New = ',ORD(NEWONE));
WRITE(LOGFILE,' Off = ',LOFF:4);
WRITE(LOGFILE,' Len = ',LLEN:4);
WRITELN(LOGFILE);
END;
END; (* getlhash *)
(*= =*)
(*======================================================================*)
FUNCTION GETLAB:PTRHASH;
VAR
CHARCOUNT : HASHRANGE;
LAB : HASHWORD;
TF : BOOLEAN;
BEGIN
SCANOVERDELIM;
FOR CHARCOUNT:=0 TO HASHCH DO
IF INPUT↑ = ' ' THEN
LAB[CHARCOUNT]:=' '
ELSE
BEGIN
LAB[CHARCOUNT]:=INPUT↑;
GET(INPUT);
END;
GETLAB:=GETHASH(LAB,TF);
END;
FUNCTION GETQSTRING:PTRLHASH;
VAR
Q : INPUTLINE;
LEN : LINERANGE;
TF : BOOLEAN;
BEGIN
LEN:=0;
SCANOVERDELIM;
WHILE INPUT↑ = '''' DO
BEGIN
REPEAT
Q[LEN]:=INPUT↑;
LEN:=LEN+1;
GET(INPUT);
UNTIL (INPUT↑ = '''') OR (EOLN(INPUT));
IF INPUT↑ = '''' THEN
BEGIN
Q[LEN]:=INPUT↑;
LEN:=LEN+1;
GET(INPUT);
END;
END;
GETQSTRING:=GETLHASH(Q,0,LEN,TF);
END;
FUNCTION GETOPCODE:OPCODERANGE;
(************************************************************************)
(* FUNCTION: Gets opcode field of up to four characters *)
(* RETURNS : Opcode *)
(************************************************************************)
VAR
WHERE : PTRHASH;
ISNEW : BOOLEAN;
KEY : HASHWORD;
I : INTEGER;
BEGIN
SCANOVERDELIM;
KEY:=' <OP>';
FOR I:=0 TO 3 DO
IF NOT EOLN(INPUT) THEN
BEGIN
KEY[I]:=INPUT↑;
GET(INPUT);
END;
WHERE:=GETHASH(KEY,ISNEW);
IF 'G' IN DEBUGSET THEN WRITELN(LOGFILE,' getunode = ',KEY);
IF ISNEW THEN
FATALERROR('bad univ opcode ')
ELSE
GETOPCODE:=UNORD(WHERE↑.OPDATA);
END;
(************************************************************************)